⓪ DEFINITION MODULE MM2Comp;⓪ (*$Z-*)⓪ ⓪ FROM SYSTEM IMPORT ADDRESS, WORD, LONGWORD;⓪ ⓪ CONST⓪$(* Festlegung der Rechnerkonfiguration:⓪'------------------------------------⓪'Konstanten für bedingte Compilierung, zur Unterscheidung einer⓪'Gepard- und einer Atari-Version. Die neueren Compiler-Versionen⓪'unterstützen nur noch die Atari-Konfiguration - bei zukünftigen⓪'Änderungen können die folgenden Werte also ignoriert werden! *)⓪%⓪'Atari = TRUE;⓪'Gepard = FALSE;⓪'RunGep = FALSE;⓪(RunST = TRUE;⓪(⓪$(* Implementationskonstanten:⓪'--------------------------⓪'Nur die maximale Set-Größe wird exportiert. Diese müssen die Expression-⓪'Routinen z.Z. kennen, um entsprechend große Puffer zum Aufbau von⓪'Set-Konstanten anzulegen. *)⓪$⓪$maxSet = 65536; (* max SetLaenge (bits) *)⓪$(*⓪&maxSetW = CARDINAL(maxSet DIV 16L); (* max. Setlaenge (words) *)⓪$*)⓪%⓪$(* Seriennummern und Prüfzahlen dazu:⓪'----------------------------------⓪'Z.Z. erfolgt die Prüfung einer der eingetragenen Seriennummern innerhalb⓪'der Expression-Auswertung. (Kann zunächst entfallen.)⓪'Dazu werden die folgenden Werte benötigt: *)⓪&⓪&SerVal0 = $4711; (* Defaulteintrag für Seriennummer *)⓪&SerVal1 = $1ADE; (* verschlüsselt nach Verfahren 1 *)⓪&SerCnt1 = 38; (* Iterationszahl-1 für Schlüssel 1 *)⓪%SerLead0 = $0641; (* führende Kennung für Seriennummern *)⓪%SerLead1 = $343C; (* willkürliche 68000-Opcodes, *)⓪#SerOffset1 = $2302; (* willkürliche 68000-Opcodes, *)⓪ ⓪$(* Symbolnummern:⓪'--------------⓪'Spezielle Symbolnummern, die von GetSbl (s.u.) geliefert werden.⓪'StrConst: Stringkonstanten in '' oder " ". Werden in den Puffer⓪1<StrBuf> (s.u.) umkopiert, Char-Zahl in <StrLen>.⓪'NumConst: numerische Konstanten. Behandlung etwas irregulär: <GetSbl>⓪1holt NICHT das Symbol (die Zahl) aus dem Text; das bleibt⓪1dem Aufrufer überlassen. (Könnte jederzeit umgestellt werden.)⓪'SymAnd, SymOr, SymNot: die drei reservierten Worte AND, OR, NOT kriegen⓪1eine Extrawurst, weil sie auch als Assembler-Symbole benutzt⓪1werden.⓪'⓪'Alle anderen Symbolnummern haben keine symbolischen Namen⓪'(schade eigentlich!) *)⓪'⓪%NumConst = $FE; (* Ziffer, num. Konstante folgt *)⓪%StrConst = $FF; (* Stringkonstante in ' oder " *)⓪%SymAnd = 124; (* AND *)⓪%SymOr = 125; (* OR *)⓪%SymNot = 175; (* NOT *)⓪ ⓪ ⓪$(* Accu *)⓪ ⓪ CONST AccuSize = 8;⓪ ⓪ VAR⓪%Accu:WORD; (* Sign & Exponent - s1..m1 gleichzeitig fuer Long-Konstanten *)⓪#AccuM1:WORD; (* Mantisse 1.Wort - m1 gleichzeitig fuer Word-Konstanten *)⓪"AccuS14:WORD; (* Mantisse 2.Wort *)⓪"AccuM14:WORD; (* Mantisse 3.Wort *)⓪ ⓪"AccuPtr:ADDRESS; (* Ptr auf Accu/Datum *)⓪ ⓪$(* Zeiger auf die Standardtypen:⓪'-----------------------------⓪'sind gedacht zur Erzeugung von Ergebnistypen (die immer in Form solcher⓪'Zeiger geliefert werden) in Expressions. Alle Zeiger sind relativ⓪'zur Baumwurzel, und natürlich sind wieder alle Werte negativ.⓪'⓪'Die Initialisierung dieser Pointer geschieht in IMPORT.ImPseud *)⓪ ⓪%IntPtr: ADDRESS; (* LongInt *)⓪$RealPtr: ADDRESS; (* Real (8 Byte) *)⓪$CardPtr: ADDRESS; (* LongCard *)⓪$CharPtr: ADDRESS; (* Char *)⓪$BoolPtr: ADDRESS; (* Boolean *)⓪$SIntPtr: ADDRESS; (* ShortInt *)⓪#SCardPtr: ADDRESS; (* ShortCard *)⓪#SBothTyp: ADDRESS; (* SHORTINT oder SHORTCARD (0 <= x <= MaxInt) *)⓪$BothTyp: ADDRESS; (* LongInt oder LongCard (0L <= x <= MaxLInt) *)⓪$BSetPtr: ADDRESS; (* BITSET *)⓪$ProcPtr: ADDRESS; (* PROC *)⓪&ZZTyp: ADDRESS; (* (MinLInt <= x <= MaxLCard) *)⓪#SRealPtr: ADDRESS; (* ShortReal (4 Byte) *)⓪%IntRel: ADDRESS; (* INTEGER (Relay auf SHORT/LONGINT) *)⓪$CardRel: ADDRESS; (* CARDINAL (Relay auf SHORT/LONGCARD) *)⓪$FrwdTyp: ADDRESS; (* hierauf zeigen noch ungelöste Proc-/Pointer-Typen *)⓪&SSTyp: ADDRESS; (* SS *)⓪$BytIPtr: ADDRESS; (* signed Byte *)⓪#UndefTyp: ADDRESS; (* strukt. Konstante *)⓪%StrPtr: ADDRESS; (* String-Literal - ab V4.3 identisch mit SSTyp *)⓪ ⓪ ⓪%Header: ADDRESS; (* ^ Anfang des erzeugten Moduls (Modulkopf) *)⓪"CodeStart: ADDRESS; (* ^ erzeugten Code-Beginn (hinter Decl-Teil) *)⓪$DataLen: LONGCARD; (* vorgegebene Länge des DATA-Puffers *)⓪"DataStart: LONGCARD; (* Start des DATA-Puffers *)⓪$DataEnd: LONGCARD; (* Ende des DATA-Puffers *)⓪$DataPtr: LONGCARD; (* ^ in DATA-Puffer *)⓪%TreSpc: ADDRESS; (* ^ aktuelles Ende des ID-Baums, relativ zur⓪<Baumwurzel. Negativ! (Baum 'hängt kopfüber') *)⓪$EvalStk: ADDRESS; (* Zwischenspeicher zum Retten von A3, das im⓪<Compiler langfristig anders belegt ist. *)⓪ ⓪%StrLen: CARDINAL; (* nach <GetSbl>: Char-Zahl des Strings in <StrBuf> *)⓪%STRBUF: ARRAY [1..256(*MaxStrLen*)] OF CHAR;⓪9(* nach <GetSbl>: Puffer fuer Stringkonstante *)⓪&⓪&Tiefe: CARDINAL; (* nach <GetSbl>, <LocalSearch>: Anzahl der Scope-⓪<Ebenen, die durchsucht wurden, bevor das Symbol⓪<gefunden wurde (Tiefe=0: aktuelles lokales Scope,⓪<größere Tiefen, wenn weiter außen) *)⓪ ⓪%Global: CARDINAL; (* Tiefe des akt. Blocks *)⓪ ⓪$Options: LONGWORD; (* aktueller Zustand der Compileroptionen.⓪<bit1 = 'A' .. bit26 = 'Z'; 0 = '-', 1 = '+'.⓪<Beachte: Andere Bit-Anordnung als in BitSets! *)⓪ ⓪#Peephole: LONGCARD; (* Enthält speziell kodierte Informationen über die⓪<VORLETZTE erzeugte Codesequenz (die LETZTE ist in⓪<D7 kodiert), um evtl. Optimierung zu ermöglichen. *)⓪ ⓪#TextOffset: LONGCARD; (* für Expr-Modul: Offset des Textes im Puffer;⓪<wird von 'reload' hochgesetzt. *)⓪ ⓪!StackReserve: LONGCARD; (* geforderte Platzreserve für Stackcheck *)⓪ ⓪&ROScope: CARDINAL; (* Anzahl Read-Only Scopes * (-4) *)⓪%⓪$WithScope: BOOLEAN; (* TRUE: Wir sind in einem WITH (f. Assembler) *)⓪ ⓪%A3Offset: LONGINT; (* Offset zu Start-A3 in Body jeder einzelnen Proc *)⓪%A7Offset: LONGINT; (* Offset zu Start-A7 in Body jeder einzelnen Proc *)⓪!StatLinkOffs: CARDINAL; (* Offset zu ParReg, bei dem der Outer FramePtr liegt*)⓪'ParReg: CARDINAL; (* Reg für Zugriff auf formale Parms (A3/A5/A6/A7) *)⓪'VarReg: CARDINAL; (* Reg für Zugriff auf lok. Vars (A3/A5/A6/A7) *)⓪ ⓪(BadId: ARRAY [0..89] OF CHAR; (* Wird bei "#" in Error-Msg eingesetzt *)⓪ ⓪&AsmMode: BOOLEAN; (* TRUE, wenn ASSEMBLER-Scope *)⓪ ⓪"HaltOnError: BOOLEAN; (* wird über "/S" in Cmdline gesetzt *)⓪ ⓪"OptimizeForSpeeed: BOOLEAN;⓪ ⓪ (*⓪!* Real-Format-Behandlung⓪!*)⓪ ⓪ TYPE FPUType = (softReal, externalFPU, internalFPU);⓪ ⓪ PROCEDURE fpu (): FPUType;⓪"(* Liefert einen der drei Werte. *)⓪ PROCEDURE RealConstIsUsed;⓪"(* Aufzurufen, wenn eine Real-Konstante benutzt wird *)⓪ PROCEDURE IEEERuntimeCall;⓪"(* Aufzurufen, wenn FPU-spezifischer Code benutzt wird (auch 881-Code!) *)⓪ ⓪ ⓪$(* Unterstützung eines LONGWORD-Stacks,⓪'------------------------------------⓪'der vor allem zum Zwischenspeichern von Typ-Zeigern verwendet wird⓪'(und aus historischen Gründen 'Integer-Stack' heißt).⓪'Alle Routinen erwarten/liefern das Ergebnis in D0 und verändern A0. *)⓪ ⓪ PROCEDURE PullInt ();⓪ PROCEDURE PushInt ();⓪ PROCEDURE LookInt (); (* liefert TopOtStack; der Wert bleibt auf dem Stack *)⓪ ⓪ ⓪$(* Scanner und verwandte Funktionen:⓪'--------------------------------- *)⓪ ⓪ PROCEDURE GetSbl ();⓪$(* Nächstes Symbol aus dem Text holen.⓪'Liefert Symbolnummer in D3; setzt Textzeiger A2 weiter.⓪'D0..D6, A0, A2 werden verändert. *)⓪ ⓪ PROCEDURE SameSbl ();⓪$(* Zuletzt gelesenes Symbol noch einmal in D3 abliefern *)⓪ ⓪ PROCEDURE FetNoSp ();⓪$(* Nächstes Zeichen nach D2 holen, White Space überlesen *)⓪ ⓪ PROCEDURE GetLPar ();⓪$(* IF GetSbl () # LinkeKlammer THEN SyntaxErr ('( expected') END *)⓪ ⓪ PROCEDURE GetRPar ();⓪$(* IF SameSbl () # RechteKlammer THEN SyntaxErr (') expected') END *)⓪ ⓪ PROCEDURE SyntaxErr ();⓪%(* Bricht Compilerlauf ab und meldet Syntaxfehler.⓪(Übergabe der Fehlernummer in D5. *)⓪(⓪(⓪$(* Suchen im Symbolbaum:⓪'---------------------⓪'<LocalSearch> durchsucht einen lokalen Baum (speziell sind das auch⓪'die Feldnamen eines Records).⓪'⓪'Parameter:⓪'D2.L Zeiger auf die Baumwurzel (relativ zu A1.L, negativ)⓪'A2.L Zeiger auf ID im Textpuffer⓪'D1.B erstes Zeichen des IDs⓪'⓪'Ergebnisse:⓪'Carry Clear, wenn ID gefunden. Dann:⓪)A2.L zeigt im Textpuffer hinter den ID⓪)D2.L Zeiger auf den Eintrag im Baum (relativ zu A1,⓪0MOVE.W -2(A1,D2.L) holt das Kennungswort)⓪'Carry Set, wenn nicht gefunden. Dann⓪)A2.L zeigt auf erstes Zeichen des ID im Textpuffer. *)⓪ ⓪ PROCEDURE LocalSearch ();⓪ ⓪ PROCEDURE TreSrc ();⓪$(* Tree-Search.⓪%* A2: Pointer auf String (null-terminiert), D2: erstes Zeichen⓪%* Returns: D3.W: itemNr, D2.L: Pointer in Baum⓪%*)⓪ ⓪$(* Codeerzeugung für Prozeduraufrufe:⓪'---------------------------------- *)⓪'⓪ ⓪ PROCEDURE CSP ();⓪$(* Call System Procedure:⓪'Aufruf einer Prozedur aus dem Runtime-Modul. Die Prozeduren werden⓪'über laufende Nummern bezeichnet, die jeweils in D3.W zu übergeben⓪'ist. Hier wird nur der Aufruf selbst erzeugt (JSR.L) und der Eintrag⓪'in die Link-Kette vorgenommen; ggf. nötige Parameterübergaben sind⓪'vorher vom Aufrufer zu erledigen.⓪'Liste der Standardprozeduren gibt's handschriftlich. *)⓪ ⓪ (*⓪ PROCEDURE CUP ();⓪ *)⓪$(* Call User Procedure:⓪'Aufruf einer Benutzer-deklarierten Prozedur. Erzeugt die Bereitstellung⓪'des StatLinks (Zeiger auf das nächstäußere sichtbare Scope) und den⓪'Aufruf (JSR.L für globale, BSR.W für lokale Prozeduren).⓪'⓪'Parameter:⓪'D2.L: Zeiger auf Prozedureintrag im Baum (A1-relativ)⓪'Tiefe: Scope-Entfernung der Prozedur vom Aufrufer⓪.(wird von <GetSbl> zum Prozedurnamen mitgeliefert)⓪.⓪'verändert D0, A4 *)⓪ ⓪ ⓪$(* Vorwärtsreferenzen in Kontrollstrukturen:⓪'-----------------------------------------⓪'Wird exportiert, da die Auswertung von Bool'schen Ausdrücken⓪'(Shortcut Evaluation bei AND, OR) diese Funktionen benötigt. *)⓪ ⓪ PROCEDURE ForwardRef ();⓪$(* legt momentane Position des Code-Zeigers auf dem Integer-Stack ab,⓪'schreibt 0.W in den Code. (Als vorläufige Entfernung eines Bcc.W,⓪'dessen Argument später nachzutragen ist.) Verändert D0, A0. *)⓪'⓪ PROCEDURE ToHere ();⓪$(* Interpretiert D2.L als Code-Position und trägt an dieser Position⓪'die Entfernung zur aktuellen Position des Code-Zeigers (als Wort)⓪'ein. Verändert D1, A0. *)⓪ ⓪ ⓪$(* Codeerzeugung: Peephole-Optimierung⓪'-----------------------------------⓪'Um aufeinanderfolgende MOVEs zu verhindern, die einen Wert hin- und⓪'herkopieren, wird der jeweils letzte erzeugte MOVE-Befehl durch eine⓪'Kodierung in D7 beschrieben. Bevor ein weiterer MOVE erzeugt wird,⓪'wird kontrolliert, ob er die Daten des vorigen Befehls weitertrans-⓪'portiert.⓪'⓪'Nur wenn dies der Fall ist, wird <MoveCut> aufgerufen. Parameter:⓪'D0.W: Opcode, der ohne 'Optimierung' zu erzeugen wäre.⓪'D7.L: Informationen über den letzten erzeugten Code.⓪'⓪'Da dieser Mechanismus vermutlich nicht weiterbenutzt wird, spare ich⓪'mir zunächst die Details der Kodierung etc. *)⓪'⓪ PROCEDURE MoveCut ();⓪ ⓪ ⓪$(* Kompatibilitätsprüfung:⓪'-----------------------⓪'Überprüft, ob zwei Typen im Wirth'schen Sinn 'kompatibel' sind⓪'(identisch oder ADDRESS<>LONGCARD, Pointer<>ADDRESS,⓪'BothTyp<>Int/Card, oder Subranges mit kompatiblen Basistypen).⓪'⓪'Alle drei Routinen liefern das Ergebnis im Zero-Flag (EQ = "kompatibel"),⓪'und erwarten zwei zu vergleichenden Typ-Zeiger - diese aber aus⓪'verschiedenen Quellen: *)⓪'⓪ PROCEDURE compat ();⓪$(* beide Typ-Zeiger auf dem Integer-Stack *)⓪ ⓪ PROCEDURE compatR ();⓪$(* ein Typ-Zeiger auf dem Integer-Stack, der andere in D2 *)⓪$⓪ PROCEDURE compatRR ();⓪$(* ein Typ-Zeiger in D0, der andere in D2 *)⓪ ⓪ PROCEDURE AsComp20;⓪$(* Src in D2, Dest in D0. Return: Errorcode in D1 *)⓪ ⓪$(* Auswertung eines Statement-Blocks:⓪'---------------------------------- *)⓪ ⓪ PROCEDURE StatSeq;⓪ ⓪$(* Auswertung von Konstanten (literale & benannte)⓪'----------------------------------------------- *)⓪ ⓪ PROCEDURE ConFact;⓪ ⓪$(* der eigentliche Compiliervorgang:⓪'--------------------------------- *)⓪ ⓪ PROCEDURE Compile ();⓪ ⓪ END MM2Comp.⓪ ⓪ ə
